home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / source / obrn-a_1.5_src.lha / oberon-a / source3.lha / Source / OC / OCI.mod < prev    next >
Encoding:
Text File  |  1995-01-26  |  13.0 KB  |  434 lines
  1. (***************************************************************************
  2.  
  3.      $RCSfile: OCI.mod $
  4.   Description: Common routines used by modules OCE, OCP, OCH and Compiler
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 5.8 $
  8.       $Author: fjc $
  9.         $Date: 1995/01/26 00:17:17 $
  10.  
  11.   Copyright © 1993-1995, Frank Copeland
  12.   This module forms part of the OC program
  13.   See OC.doc for conditions of use and distribution
  14.  
  15.   Log entries are at the end of the file.
  16.  
  17. ***************************************************************************)
  18.  
  19. <* STANDARD- *> <* MAIN- *> <*$ LongVars+ *>
  20.  
  21. MODULE OCI;
  22.  
  23. IMPORT OCM, OCS, OCT, OCC;
  24.  
  25. (* --- Local declarations ----------------------------------------------- *)
  26.  
  27. CONST
  28.  
  29.   (* object modes *)
  30.  
  31.   Var = OCM.Var; VarX = OCM.VarX; Ind = OCM.Ind; IndX = OCM.IndX;
  32.   RegI = OCM.RegI; RegX = OCM.RegX; Lab = OCM.Lab; LabI = OCM.LabI;
  33.   Con = OCM.Con; Push = OCM.Push; Pop = OCM.Pop; Coc = OCM.Coc;
  34.   Reg = OCM.Reg; Fld = OCM.Fld; Typ = OCM.Typ; Abs = OCM.Abs;
  35.   XProc = OCM.XProc; LProc = OCM.LProc; Undef = OCM.Undef;
  36.  
  37.   addressableSet =
  38.     {Var, VarX, Ind, IndX, Reg, RegI, RegX, Con, XProc, LProc};
  39.  
  40.   (* structure forms *)
  41.  
  42.   Char = OCT.Char; DynArr = OCT.DynArr;
  43.  
  44.   (* CPU Registers *)
  45.  
  46.   D0 = 0; D1 = 1; D7 = 7; A0 = 8; A3 = 11; A4 = 12; A5 = 13; A6 = 14;
  47.   A7 = 15; BP = A4 - 8; FP = A5 - 8; SP = A7 - 8;
  48.   DataRegs = {D0 .. D7};
  49.   AdrRegs = {A0 .. A7};
  50.  
  51.   (* Data sizes *)
  52.  
  53.   B = 1; W = 2; L = 4;
  54.  
  55. (* CONST mname = "OCI"; *)
  56.  
  57. (* --- Procedure declarations ------------------------------------------- *)
  58.  
  59. (*------------------------------------*)
  60. PROCEDURE IsParam * (obj : OCT.Object) : BOOLEAN;
  61.  
  62. BEGIN (* IsParam *)
  63.   RETURN (obj # NIL) & (obj.mode <= Ind) & (obj.a0 >= 0)
  64. END IsParam;
  65.  
  66. (*------------------------------------*)
  67. (*
  68.   Explicitly frees any registers used by x
  69. *)
  70. PROCEDURE Unload * (VAR x : OCT.Item);
  71.  
  72.   (* CONST pname = "Unload"; *)
  73.  
  74. BEGIN (* Unload *)
  75.   (* OCM.TraceIn (mname, pname); *)
  76.   IF x.mode IN {VarX, IndX, Reg, RegI, RegX, Push, Pop} THEN
  77.     OCC.FreeReg (x);
  78.   END
  79.   (* ;OCM.TraceOut (mname, pname); *)
  80. END Unload;
  81.  
  82. (*------------------------------------*)
  83. PROCEDURE Load * (VAR x : OCT.Item);
  84.  
  85.   (* CONST pname = "Load"; *)
  86.  
  87.   VAR y : OCT.Item;
  88.  
  89. BEGIN (* Load *)
  90.   (* OCM.TraceIn (mname, pname); *)
  91.   IF x.mode < Reg THEN
  92.     y := x; OCC.GetDReg (x); OCC.Move (y.typ.size, y, x); Unload (y)
  93.   ELSIF x.mode > Reg THEN
  94.     OCS.Mark (126); OCS.Warn (2); OCS.Warn (x.mode)
  95.   END
  96.   (* ;OCM.TraceOut (mname, pname); *)
  97. END Load;
  98.  
  99. (*------------------------------------*)
  100. PROCEDURE EXT * (size, reg : LONGINT);
  101.  
  102.   (* CONST pname = "EXT"; *)
  103.  
  104. BEGIN (* EXT *)
  105.   (* OCM.TraceIn (mname, pname); *)
  106.   IF size = L THEN OCC.PutWord (OCC.EXTL + SHORT (reg))
  107.   ELSE OCC.PutWord (OCC.EXTW + SHORT (reg))
  108.   END
  109.   (* ;OCM.TraceOut (mname, pname); *)
  110. END EXT;
  111.  
  112. (*------------------------------------*)
  113. PROCEDURE DescItem * (VAR item : OCT.Item; desc : OCT.Desc; adr : LONGINT);
  114.  
  115.   (* CONST pname = "DescItem"; *)
  116.  
  117. BEGIN (* DescItem *)
  118.   (* OCM.TraceIn (mname, pname); *)
  119.   IF desc = NIL THEN
  120.     OCS.Mark (963);
  121.     item.lev := 0; item.mode := Var;
  122.     item.a0 := 0; item.a1 := 0; item.a2 := 0
  123.   ELSE
  124.     (* item = bound descr *)
  125.     item.lev := desc.lev; item.mode := desc.mode; item.a0 := desc.a0;
  126.     item.a1 := desc.a1; item.a2 := desc.a2;
  127.     IF item.mode IN {Var, VarX} THEN INC (item.a0, adr)
  128.     ELSIF item.mode IN {Ind, IndX, RegI, RegX} THEN INC (item.a1, adr)
  129.     ELSE OCS.Mark (322)
  130.     END
  131.   END;
  132.   item.desc := desc; item.typ := OCT.linttyp; item.wordIndex := FALSE
  133.   (* ;OCM.TraceOut (mname, pname); *)
  134. END DescItem;
  135.  
  136. (*------------------------------------*)
  137. PROCEDURE UpdateDesc * (VAR x : OCT.Item; adr : LONGINT);
  138.  
  139.   (* CONST pname = "UpdateDesc"; *)
  140.  
  141.   VAR desc : OCT.Desc;
  142.  
  143. BEGIN (* UpdateDesc *)
  144.   (* OCM.TraceIn (mname, pname); *)
  145.   desc := x.desc;
  146.   IF desc # NIL THEN
  147.     desc.lev := x.lev; desc.mode := x.mode; desc.a0 := x.a0;
  148.     desc.a1 := x.a1; desc.a2 := x.a2;
  149.     IF desc.mode IN {Var, VarX} THEN DEC (desc.a0, adr)
  150.     ELSIF desc.mode IN {Ind, IndX, RegI, RegX} THEN DEC (desc.a1, adr)
  151.     ELSE OCS.Mark (322)
  152.     END
  153.   END
  154.   (* ;OCM.TraceOut (mname, pname); *)
  155. END UpdateDesc;
  156.  
  157. (*------------------------------------*)
  158. PROCEDURE UnloadDesc * (VAR x : OCT.Item);
  159.  
  160.   (* CONST pname = "UnloadDesc"; *)
  161.  
  162.   VAR desc : OCT.Desc;
  163.  
  164. BEGIN (* UnloadDesc *)
  165.   (* OCM.TraceIn (mname, pname); *)
  166.   desc := x.desc;
  167.   IF (desc # NIL) & (desc.mode IN {VarX, IndX, RegI, RegX}) THEN
  168.     IF desc.mode # x.mode THEN
  169.       IF desc.mode IN {RegI, RegX} THEN
  170.         OCC.UnReserveReg (SHORT (desc.a0))
  171.       END;
  172.       IF desc.mode IN {VarX, IndX, RegX} THEN
  173.         OCC.UnReserveReg (SHORT (desc.a2))
  174.       END
  175.     ELSE
  176.       IF desc.mode IN {RegI, RegX} THEN
  177.         IF desc.a0 # x.a0 THEN OCC.UnReserveReg (SHORT (desc.a0)) END
  178.       END;
  179.       IF desc.mode IN {VarX, IndX, RegX} THEN
  180.         IF desc.a2 # x.a2 THEN OCC.UnReserveReg (desc.a2) END
  181.       END;
  182.     END
  183.   END
  184.   (* ;OCM.TraceOut (mname, pname); *)
  185. END UnloadDesc;
  186.  
  187. (*------------------------------------*)
  188. PROCEDURE Adr * (VAR x : OCT.Item);
  189.  
  190.   (* CONST pname = "Adr"; *)
  191.  
  192.   VAR
  193.     reg, len, y : OCT.Item; module : OCT.Module; off : LONGINT;
  194.     dreg : INTEGER; wordIndex : BOOLEAN;
  195.  
  196.   (*------------------------------------*)
  197.   PROCEDURE Multiply (VAR lhs, rhs : OCT.Item);
  198.  
  199.   (* CONST pname = "Multiply"; *)
  200.  
  201.     VAR R : SET;
  202.  
  203.   BEGIN (* Multiply *)
  204.     (* OCM.TraceIn (mname, pname); *)
  205.     OCC.LoadRegParams2 (R, lhs, rhs);
  206.     OCC.CallKernel (OCC.kMul32);
  207.     OCC.RestoreRegisters (R, lhs);
  208.     Unload (rhs)
  209.     (* ;OCM.TraceOut (mname, pname); *)
  210.   END Multiply;
  211.  
  212. BEGIN (* Adr *)
  213.   (* OCM.TraceIn (mname, pname); *)
  214.   IF x.mode IN addressableSet THEN
  215.     IF (x.mode = Con) & (x.typ # OCT.stringtyp) THEN OCS.Mark (127)
  216.     ELSIF x.typ.form = DynArr THEN
  217.       len.mode := Undef;
  218.       IF x.mode IN {IndX, RegX} THEN
  219.         reg.mode := Reg; reg.a0 := x.a2; reg.typ := OCT.linttyp;
  220.       END;
  221.       WHILE x.typ.form = DynArr DO
  222.         IF x.mode IN {IndX, RegX} THEN
  223.           DescItem (len, x.desc, x.typ.adr); Multiply (reg, len)
  224.         END;
  225.         x.typ := x.typ.BaseTyp
  226.       END;
  227.       Unload (len);
  228.       IF x.mode = Var THEN x.mode := Ind; x.a1 := 0 END;
  229.       Adr (x)
  230.     ELSIF x.mode = Reg THEN
  231.       IF x.a0 IN DataRegs THEN OCS.Mark (127) END
  232.     ELSIF x.mode = Con THEN
  233.       IF x.a1 < 3 THEN OCC.AllocStringFromChar (x) END;
  234.       x.mode := LabI; x.a1 := 4
  235.     ELSIF x.mode = Var THEN
  236.       y := x; OCC.GetAReg (x); OCC.PutF2 (OCC.LEA, y, x.a0); Unload (y)
  237.     ELSIF x.mode = VarX THEN
  238.       dreg := x.a2; wordIndex := x.wordIndex;
  239.       y := x; y.mode := Var; y.a2 := 0;
  240.       OCC.GetAReg (x); OCC.PutF2 (OCC.LEA, y, x.a0); Unload (y);
  241.       y.mode := RegX; y.a0 := x.a0; y.a1 := 0; y.a2 := dreg;
  242.       y.wordIndex := wordIndex;
  243.       OCC.PutF2 (OCC.LEA, y, x.a0); OCC.UnReserveReg (dreg)
  244.     ELSIF x.mode = Ind THEN
  245.       IF x.a1 = 0 THEN x.mode := Var
  246.       ELSE
  247.         y := x; y.mode := Var; OCC.GetAReg (reg); reg.desc := x.desc;
  248.         OCC.Move (L, y, reg); Unload (y);
  249.         y.mode := RegI; y.a0 := reg.a0; y.a1 := x.a1; x := reg;
  250.         OCC.PutF2 (OCC.LEA, y, x.a0)
  251.       END
  252.     ELSIF x.mode = IndX THEN
  253.       off := x.a1; dreg := x.a2; wordIndex := x.wordIndex;
  254.       y := x; y.mode := Var; y.a2 := 0;
  255.       OCC.GetAReg (x); OCC.Move (L, y, x); Unload (y);
  256.       IF off # 0 THEN
  257.         y.mode := RegI; y.a0 := x.a0; y.a1 := off;
  258.         OCC.PutF2 (OCC.LEA, y, x.a0)
  259.       END;
  260.       y.mode := RegX; y.a0 := x.a0; y.a1 := 0; y.a2 := dreg;
  261.       y.wordIndex := wordIndex;
  262.       OCC.PutF2 (OCC.LEA, y, x.a0); OCC.UnReserveReg (dreg);
  263.       x.mode := Reg
  264.     ELSIF x.mode = RegI THEN
  265.       IF x.a1 # 0 THEN OCC.PutF2 (OCC.LEA, x, x.a0) END;
  266.       x.mode := Reg; x.a1 := 0
  267.     ELSIF x.mode = RegX THEN
  268.       y := x; x.mode := Reg; x.a1 := 0; x.a2 := 0;
  269.       OCC.PutF2 (OCC.LEA, y, x.a0); OCC.UnReserveReg (y.a2)
  270.     ELSIF x.mode IN {LProc, XProc} THEN
  271.       x.mode := LabI; x.a0 := 0; x.a1 := 4; x.label := x.obj.label
  272.     END;
  273.     IF x.mode = Reg THEN x.a1 := 0; x.a2 := 0; x.obj := NIL END
  274.   ELSE
  275.     OCS.Mark (127)
  276.   END
  277.   (* ;OCM.TraceOut (mname, pname); *)
  278. END Adr;
  279.  
  280. (*------------------------------------*)
  281. PROCEDURE LoadAdr * (VAR x : OCT.Item);
  282.  
  283.   (* CONST pname = "LoadAdr"; *)
  284.  
  285.   VAR y : OCT.Item;
  286.  
  287. BEGIN (* LoadAdr *)
  288.   (* OCM.TraceIn (mname, pname); *)
  289.   Adr (x);
  290.   IF x.mode # Reg THEN y := x; OCC.GetAReg (x); OCC.Move (L, y, x) END;
  291.   x.mode := RegI; x.a1 := 0; x.a2 := 0; x.obj := NIL
  292.   (* ;OCM.TraceOut (mname, pname); *)
  293. END LoadAdr;
  294.  
  295. (*------------------------------------*)
  296. (*
  297.   Move the address of a variable, procedure or string constant to the
  298.   specified location.
  299. *)
  300. PROCEDURE MoveAdr * (VAR x, y : OCT.Item);
  301.  
  302.   (* CONST pname = "MoveAdr"; *)
  303.  
  304.   VAR
  305.     z : OCT.Item; module : OCT.Object; off : LONGINT; reg : INTEGER;
  306.     wordIndex : BOOLEAN;
  307.  
  308. BEGIN (* MoveAdr *)
  309.   (* OCM.TraceIn (mname, pname); *)
  310.   IF x.mode IN addressableSet THEN
  311.     IF x.mode = Reg THEN
  312.       IF x.a0 < A0 THEN OCS.Mark (127)
  313.       ELSE OCC.Move (L, x, y)
  314.       END
  315.     ELSIF (y.mode = Reg) & (y.a0 >= A0) THEN
  316.       IF x.typ.form = DynArr THEN Adr (x); OCC.Move (L, x, y)
  317.       ELSIF x.mode = Reg THEN OCC.Move (L, x, y)
  318.       ELSIF x.mode = Ind THEN
  319.         z := x; z.mode := Var; OCC.Move (L, z, y);
  320.         IF z.a1 # 0 THEN
  321.           z.mode := RegI; z.a0 := y.a0; OCC.PutF2 (OCC.LEA, z, y.a0)
  322.         END
  323.       ELSIF x.mode = IndX THEN
  324.         off := x.a1; reg := x.a2; wordIndex := x.wordIndex;
  325.         z := x; z.mode := Var; OCC.Move (L, z, y);
  326.         z.mode := RegX; z.a0 := y.a0; z.a1 := off; z.a2 := reg;
  327.         z.wordIndex := wordIndex;
  328.         OCC.PutF2 (OCC.LEA, z, y.a0)
  329.       ELSIF x.mode IN {LProc, XProc} THEN
  330.         x.mode := Lab; x.a0 := 0; x.a1 := 4; x.label := x.obj.label;
  331.         OCC.PutF2 (OCC.LEA, x, y.a0)
  332.       ELSE
  333.         OCC.PutF2 (OCC.LEA, x, y.a0)
  334.       END
  335.     ELSE
  336.       Adr (x); OCC.Move (L, x, y)
  337.     END
  338.   ELSE
  339.     OCS.Mark (127)
  340.   END
  341.   (* ;OCM.TraceOut (mname, pname); *)
  342. END MoveAdr;
  343.  
  344. (*------------------------------------*)
  345. (*
  346.   Copies count bytes from src to dst and then terminates dst with a NUL.
  347. *)
  348. PROCEDURE CopyString *
  349.   ( VAR src, dst, count : OCT.Item );
  350.  
  351.   (* CONST pname = "CopyString"; *)
  352.  
  353.   VAR x : OCT.Item; L0 : INTEGER; i : LONGINT;
  354.  
  355. BEGIN (* CopyString *)
  356.   (* OCM.TraceIn (mname, pname); *)
  357.   IF (count.mode = Con) & (count.a0 < 5)  THEN (* inline the loop *)
  358.     IF count.a0 = 1 THEN
  359.       LoadAdr (dst); dst.mode := Pop;            (*    LEA    <dst>,Ad    *)
  360.       IF src.mode = Con THEN src.a0 := src.a2; src.typ := OCT.chartyp END;
  361.       OCC.Move (B, src, dst);                    (*    MOVE.B <src>,(Ad)+ *)
  362.       dst.mode := RegI
  363.     ELSIF count.a0 > 1 THEN
  364.       LoadAdr (src); src.mode := Pop;            (*    LEA    <src>,As    *)
  365.       LoadAdr (dst); dst.mode := Pop;            (*    LEA    <dst>,Ad    *)
  366.       i := count.a0;
  367.       WHILE i > 0 DO
  368.         OCC.Move (B, src, dst);                  (*    MOVE.B (As),(Ad)+  *)
  369.         DEC (i)
  370.       END;
  371.       dst.mode := RegI
  372.     ELSE (* src is an empty string *)
  373.       IF (dst.typ.form = DynArr) & (dst.mode IN {IndX, RegX}) THEN
  374.         LoadAdr (dst)                            (*    LEA    <dst>,Ad    *)
  375.       END
  376.     END;
  377.     OCC.PutF1 (OCC.CLR, B, dst)                  (*    CLR.B  <dst>       *)
  378.   ELSE
  379.     LoadAdr (src); src.mode := Pop;              (*    LEA    <src>,As    *)
  380.     LoadAdr (dst); dst.mode := Pop;              (*    LEA    <dst>,Ad    *)
  381.  
  382.     IF count.mode = Con THEN
  383.       IF count.a0 > 32767 THEN OCS.Mark (63); count.a0 := 1 END;
  384.       count.typ := OCT.inttyp; DEC (count.a0);
  385.       Load (count);                              (*    MOVE.L <count>,Dc  *)
  386.     ELSE
  387.       Load (count);                              (*    MOVE.L <count>,Dc  *)
  388.       OCC.PutF7 (OCC.SUBQ, L, 1, count);         (*    SUBQ.L #1,Dc       *)
  389.       OCC.PutWord (6002H);                       (*    BRA.S  2$          *)
  390.     END; (* IF *)
  391.     OCC.Move (B, src, dst);                      (* 1$ MOVE.B (As)+,(Ad)+ *)
  392.     OCC.PutWord (OCC.DBEQ + SHORT (count.a0));
  393.     OCC.PutWord (-4);                            (* 2$ DBEQ.W Dc, 1$      *)
  394.     OCC.PutWord (6702H);                         (*    BEQ.S  3$          *)
  395.     dst.mode := RegI; OCC.PutF1 (OCC.CLR, B, dst)(*    CLR.B  <dst>       *)
  396.   END;                                           (* 3$                    *)
  397.   (* ;OCM.TraceOut (mname, pname); *)
  398. END CopyString;
  399.  
  400. END OCI.
  401.  
  402. (***************************************************************************
  403.  
  404.   $Log: OCI.mod $
  405.   Revision 5.8  1995/01/26  00:17:17  fjc
  406.   - Release 1.5
  407.  
  408.   Revision 5.8  1995/01/26  00:15:16  fjc
  409.   - Release 1.5
  410.  
  411.   Revision 5.7  1995/01/05  11:36:03  fjc
  412.   *** empty log message ***
  413.  
  414.   Revision 5.6  1995/01/03  21:21:29  fjc
  415.   - Changed OCG to OCM.
  416.  
  417.   Revision 5.5  1994/12/16  17:20:24  fjc
  418.   - Changed Symbol to Label.
  419.  
  420.   Revision 5.4  1994/10/23  16:08:14  fjc
  421.   - Fixed register allocation bug in UnloadDesc().
  422.   - Changed Multiply() to use OCC.CallKernel().
  423.  
  424.   Revision 5.3  1994/09/25  17:47:18  fjc
  425.   - Changed to reflect new object modes and system flags.
  426.  
  427.   Revision 5.2  1994/09/15  10:27:13  fjc
  428.   - Replaced switches with pragmas.
  429.  
  430.   Revision 5.1  1994/09/03  19:29:08  fjc
  431.   - Bumped version number
  432.  
  433. ***************************************************************************)
  434.